O objetivo do checkpoint 3 do Lab 3 é realizar novamente a clusterização de algum conjunto de dados, porém desta vez o foco é a visualização dos dados através de técnicas de redução de dimensionalidade.

Para esse checkpoint, foram utilizados dados quantitativos que a CAPES utiliza na avaliação dos programas de pós-graduação em Ciência da Computação segundo o Comitê de Avaliação. Os dados foram coletados da Plataforma Sucupira, e incluem quantificações da produção de artigos, dissertações e teses nos últimos 4 anos para os diferentes PPGs.

Escolha bem as suas variáveis, transformações, normalização, etc., e faça um descritivo das variáveis antes de começar. Também lembre de comentar os grupos encontrados e, principalmente para essa parte do problema, as relações entre as dimensões que você encontrou via PCA e as variáveis originais. Sempre comente também os padrões interessantes que você encontrar.

0. Imports and Settings

library(broom)
library(cluster)
library(dplyr, warn.conflicts = FALSE)
library(GGally, warn.conflicts = FALSE)
library(ggdendro)
library(ggplot2)
library(ggfortify)
library(highcharter, quietly = TRUE)
library(knitr)
library(readr)
library(tibble)
library(tidyr)
require(Rtsne, quietly = TRUE)
source('multiplot.R')

1. Análise Descritiva

Primeiramente, vou carregar os dados e ter uma noção do seus valores:

dados_all <- read_csv("data/capes-cacc.csv")
glimpse(dados_all)
## Observations: 75
## Variables: 31
## $ Instituição                <chr> "UNIVERSIDADE FEDERAL DO AMAZONAS",...
## $ Programa                   <chr> "INFORMÁTICA (12001015012P2)", "CIÊ...
## $ Nível                      <int> 5, 4, 3, 3, 3, 5, 4, 3, 3, 3, 5, 3,...
## $ Sigla                      <chr> "UFAM", "UFPA", "UFMA", "UEMA", "FU...
## $ Tem doutorado              <chr> "Sim", "Sim", "Não", "Não", "Não", ...
## $ Docentes colaboradores     <dbl> 0.25, 5.50, 3.00, 6.25, 1.75, 2.00,...
## $ Docentes permanentes       <dbl> 24.75, 14.00, 10.00, 14.00, 9.50, 2...
## $ Docentes visitantes        <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.75,...
## $ Resumos em conf            <int> 20, 23, 15, 5, 4, 10, 6, 136, 0, 24...
## $ Resumos expandidos em conf <int> 25, 24, 7, 10, 1, 68, 9, 13, 4, 6, ...
## $ Artigos em conf            <int> 390, 284, 115, 73, 150, 269, 179, 0...
## $ Dissertacoes               <int> 108, 77, 50, 25, 31, 75, 60, 129, 4...
## $ Teses                      <int> 14, NA, NA, NA, NA, 24, 5, NA, NA, ...
## $ periodicos_A1              <int> 15, 19, 5, 1, 7, 21, 21, 0, 3, 8, 4...
## $ periodicos_A2              <int> 19, 21, 11, 1, 4, 32, 13, 0, 9, 2, ...
## $ periodicos_B1              <int> 19, 38, 7, 3, 6, 26, 16, 2, 6, 4, 3...
## $ periodicos_B2              <int> 1, 12, 2, 6, 0, 0, 11, 0, 0, 2, 1, ...
## $ periodicos_B3              <int> 3, 16, 2, 2, 3, 16, 15, 0, 4, 6, 9,...
## $ periodicos_B4              <int> 0, 4, 0, 3, 3, 0, 1, 3, 1, 6, 0, 0,...
## $ periodicos_B5              <int> 10, 16, 8, 4, 12, 4, 16, 2, 6, 2, 1...
## $ periodicos_C               <int> 9, 34, 12, 5, 2, 3, 11, 9, 5, 10, 1...
## $ periodicos_NA              <int> 7, 15, 8, 11, 12, 6, 19, 31, 7, 14,...
## $ per_comaluno_A1            <int> 4, 1, 0, 0, 1, 7, 5, 0, 1, 0, 10, N...
## $ per_comaluno_A2            <int> 5, 5, 5, 0, 2, 15, 3, 0, 3, 0, 3, N...
## $ per_comaluno_B1            <int> 4, 2, 5, 2, 2, 14, 6, 0, 2, 0, 17, ...
## $ per_comaluno_B2            <int> 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, NA...
## $ per_comaluno_B3            <int> 2, 2, 0, 1, 0, 7, 9, 0, 2, 0, 4, NA...
## $ per_comaluno_B4            <int> 0, 0, 0, 0, 2, 0, 1, 0, 1, 3, 0, NA...
## $ per_comaluno_B5            <int> 5, 0, 4, 0, 8, 3, 6, 0, 4, 0, 4, NA...
## $ per_comaluno_C             <int> 6, 5, 3, 1, 2, 3, 7, 1, 2, 4, 8, NA...
## $ per_comaluno_NA            <int> 6, 14, 2, 2, 9, 3, 6, 4, 5, 1, 10, ...

A primeira modificação que vou efetuar nos dados é setar os valores nulos para 0. Além disso, vou criar duas novas colunas:

Logo, além dessas duas variáveis, para essa análise, também considerarei outras seis variáveis:

Para fins de visualização, também vou armazenar o nome da instituição.

dados <- dados_all %>%
  replace(is.na(.), 0) %>%
  mutate(periodicos_restrito = periodicos_A1 + periodicos_A2 + periodicos_B1) %>%
  mutate(periodicos_qualis = periodicos_B1 + periodicos_B2 + periodicos_B3 + periodicos_B4 + periodicos_B5) %>%
  select(instituicao = Instituição,
         nivel = Nível,
         colaboradores = `Docentes colaboradores`,
         permanentes = `Docentes permanentes`,
         artigos_conf = `Artigos em conf`,
         dissertacoes = Dissertacoes,
         teses = Teses,
         periodicos_restrito,
         periodicos_qualis)

dados %>% head()
## # A tibble: 6 × 9
##                              instituicao nivel colaboradores permanentes
##                                    <chr> <int>         <dbl>       <dbl>
## 1       UNIVERSIDADE FEDERAL DO AMAZONAS     5          0.25       24.75
## 2           UNIVERSIDADE FEDERAL DO PARÁ     4          5.50       14.00
## 3       UNIVERSIDADE FEDERAL DO MARANHÃO     3          3.00       10.00
## 4      UNIVERSIDADE ESTADUAL DO MARANHÃO     3          6.25       14.00
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ     3          1.75        9.50
## 6          UNIVERSIDADE FEDERAL DO CEARÁ     5          2.00       20.75
## # ... with 5 more variables: artigos_conf <int>, dissertacoes <dbl>,
## #   teses <dbl>, periodicos_restrito <int>, periodicos_qualis <int>

Vamos começar analisando o sumário dos dados:

dados %>%
  select(-instituicao) %>%
  summary()
##      nivel       colaboradores     permanentes     artigos_conf  
##  Min.   :3.000   Min.   : 0.000   Min.   : 3.00   Min.   :  0.0  
##  1st Qu.:3.000   1st Qu.: 1.125   1st Qu.:11.00   1st Qu.:121.5  
##  Median :3.000   Median : 3.000   Median :16.00   Median :187.0  
##  Mean   :3.813   Mean   : 3.990   Mean   :20.22   Mean   :239.6  
##  3rd Qu.:4.000   3rd Qu.: 5.625   3rd Qu.:25.50   3rd Qu.:293.5  
##  Max.   :7.000   Max.   :22.250   Max.   :67.25   Max.   :959.0  
##   dissertacoes        teses        periodicos_restrito periodicos_qualis
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00      Min.   :  1.00   
##  1st Qu.: 35.50   1st Qu.:  0.00   1st Qu.: 17.50      1st Qu.: 18.50   
##  Median : 56.00   Median :  0.00   Median : 40.00      Median : 32.00   
##  Mean   : 73.77   Mean   : 14.56   Mean   : 56.87      Mean   : 42.39   
##  3rd Qu.:102.50   3rd Qu.: 14.00   3rd Qu.: 66.00      3rd Qu.: 53.00   
##  Max.   :433.00   Max.   :152.00   Max.   :355.00      Max.   :274.00

O sumário dos dados apresentam informações interessantes:

Também é importante saber o desvio-padrão dessas variáveis:

dados %>%
  summarise(sd(colaboradores), sd(permanentes), sd(artigos_conf), sd(dissertacoes), sd(teses), sd(periodicos_qualis), sd(periodicos_restrito))
## # A tibble: 1 × 7
##   `sd(colaboradores)` `sd(permanentes)` `sd(artigos_conf)`
##                 <dbl>             <dbl>              <dbl>
## 1            3.967444          12.35931             183.73
## # ... with 4 more variables: `sd(dissertacoes)` <dbl>, `sd(teses)` <dbl>,
## #   `sd(periodicos_qualis)` <dbl>, `sd(periodicos_restrito)` <dbl>

Podemos ver que artigos em conferência apresentam o maior desvio-padrão, seguido por periódicos no Qualis restrito e dissertações, respectivamente.

Vamos agora analisar a distribuição das variáveis individualmente e aos pares:

dados %>%
  select(-instituicao) %>%
  ggpairs()

Ao analisar as variáveis de forma individual (diagonal principal), podemos ver que praticamente todas as variáveis apresentam uma distribuição à esquerda com cauda longa à direita. É importante destacar que a variável nível apresenta uma distribuição bimodal, devido ao fato de existirem mais programas de pós-graduação com níveis mais baixos (3 e 4).

Por outro lado, quando analisamos as variáveis aos pares, podemos ver que existem bastante correlações fortes (> 0.7) entre as variáveis. A maior correlação é observada entre a quantidade de periódicos publicados no Qualis restrito e nos demais Qualis (0.925), ou seja, quanto mais se publica periódicos em eventos com Qualis restrito, mais se publica nos demais Qualis. Obviamente, isso não representa uma causalidade, mas, de certa forma, é um comportamento esperado. Também pode-se observar forte correlação entre a quantidade artigos publicados em periódicos com Qualis restrito e a docentes permanentes (0.901) e artigos publicados em conferências (0.904).

Agora, quero fazer algumas visualizações. Primeiramente, quero analisar a distribuição dos níveis dos programas de pós-graduação do país:

dados %>%
  ggplot(aes(x = nivel)) +
  geom_bar()

Como visto anteriormente, a maior parte dos programas de pós-graduação apresentam os níveis 3 e 4. Há apenas 5 programas com nível 5. É interessante observar que há mais programas de nível 7 do que 6 (5 contra 3, respectivamente).

Vamos analisar quais são as instituições que mais produzem dissertações de Mestrado:

dados %>%
  top_n(10, dissertacoes) %>%
  ggplot(aes(x = reorder(instituicao, dissertacoes), y = dissertacoes)) +
  geom_bar(stat = "identity") +
  coord_flip()

A UFPE é a universidade brasileira que mais produz dissertações de Mestrado no país (+400), produzindo mais que o dobro da segunda colocada, a USP (São Carlos).

E qual será a universidade que mais produz teses de Doutorado?

dados %>%
  top_n(10, teses) %>%
  ggplot(aes(x = reorder(instituicao, teses), y = teses)) +
  geom_bar(stat = "identity") +
  coord_flip()

Nesse caso, ocorre o inverso, com a USP (São Carlos) à frente da UFPE. Porém, a quantidade de teses produzidas é bem mais parecida entre as duas universidades.

Qual a universidade que mais publica artigos em conferência?

dados %>%
  top_n(10, artigos_conf) %>%
  ggplot(aes(x = reorder(instituicao, artigos_conf), y = artigos_conf)) +
  geom_bar(stat = "identity") +
  coord_flip()

De forma individual, a USP de São Carlos é a universidade responsável pelo maior número de publicações em conferências. Porém, a UFPE aparece com um número maior devido quando somados os dois programas de pós-graduação (stricto sensu e profisional).

Quero agora saber a respeito das publicações em periódicos. Primeiramente, quero analisar as publicações dos periódicos fora do Qualis restrito (B2 a B5):

dados %>%
  top_n(10, periodicos_qualis) %>%
  ggplot(aes(x = reorder(instituicao, periodicos_qualis), y = periodicos_qualis)) +
  geom_bar(stat = "identity") +
  coord_flip()

Novamente, a USP (São Carlos) lidera o ranking, com aproximadamente o dobro da segunda colocada, a UniCamp. A UFRJ publica aproximadamente 200 artigos quando considerados os dois programas da pós-graduação (Informática e Engenharia de Sistemas e Computação).

Por fim, quero fazer a mesma análise, porém para os artigos publicados em periódicos no Qualis restrito:

dados %>%
  top_n(10, periodicos_restrito) %>%
  ggplot(aes(x = reorder(instituicao, periodicos_restrito), y = periodicos_restrito)) +
  geom_bar(stat = "identity") +
  coord_flip()

Mais uma vez, a USP de São Carlos encabeça o ranking, seguido pela UFPE se considerarmos os dois programas de pós-graduação descritos anteriormente.

É válido destacar que, de maneira geral, algumas das universidades mostradas nos gráficos acima aparecem em praticamente todos os gráficos. Talvez isso indique algum grupo que vamos encontrar no agrupamento que iremos realizar.

Para finalizar a análise descritiva, quero analisar a disposição das variáveis de forma individual:

plot_nivel <- dados %>%
  ggplot(aes(x = 0, y = nivel)) +
  geom_point(alpha = 0.3) 

plot_colaboradores <- dados %>%
  ggplot(aes(x = 0, y = colaboradores)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_permanentes <- dados %>%
  ggplot(aes(x = 0, y = permanentes)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_artigos_conf <- dados %>%
  ggplot(aes(x = 0, y = artigos_conf)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_dissertacoes <- dados %>%
  ggplot(aes(x = 0, y = dissertacoes)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_teses <- dados %>%
  ggplot(aes(x = 0, y = teses)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_per_qualis <- dados %>%
  ggplot(aes(x = 0, y = periodicos_qualis)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

plot_per_restrito <- dados %>%
  ggplot(aes(x = 0, y = periodicos_restrito)) +
  geom_boxplot() +
  geom_point(alpha = 0.5, position = position_jitter(width = 0.01)) 

multiplot(plot_nivel, plot_colaboradores, plot_permanentes, plot_artigos_conf, plot_dissertacoes, plot_teses, plot_per_qualis, plot_per_restrito, cols = 4)

Pelo gráfico acima, conseguimos confirmar que as variáveis se concentram na parte inferior do gráfico, como visto no gráfico de pares. Eu também arriscaria dizer que existem de 3 a 5 grupos de universidades. Vamos verificar isso na próxima seção.

2. Clusterização

dados_pro <- dados %>%
  mutate(colaboradores = as.vector(scale(colaboradores)),
         permanentes = as.vector(scale(permanentes)),
         artigos_conf = as.vector(scale(artigos_conf+1)),
         dissertacoes = as.vector(scale(dissertacoes+1)),
         teses = as.vector(scale(teses+1)),
         periodicos_qualis = as.vector(scale(periodicos_qualis+1)),
         periodicos_restrito = as.vector(scale(periodicos_restrito+1)))

dados_pro %>% head()
## # A tibble: 6 × 9
##                              instituicao nivel colaboradores permanentes
##                                    <chr> <int>         <dbl>       <dbl>
## 1       UNIVERSIDADE FEDERAL DO AMAZONAS     5    -0.9426725  0.36625548
## 2           UNIVERSIDADE FEDERAL DO PARÁ     4     0.3805977 -0.50353386
## 3       UNIVERSIDADE FEDERAL DO MARANHÃO     3    -0.2495310 -0.82717640
## 4      UNIVERSIDADE ESTADUAL DO MARANHÃO     3     0.5696363 -0.50353386
## 5 FUNDAÇÃO UNIVERSIDADE FEDERAL DO PIAUÍ     3    -0.5645953 -0.86763172
## 6          UNIVERSIDADE FEDERAL DO CEARÁ     5    -0.5015824  0.04261293
## # ... with 5 more variables: artigos_conf <dbl>, dissertacoes <dbl>,
## #   teses <dbl>, periodicos_restrito <dbl>, periodicos_qualis <dbl>

2.1 Clusterização Hierárquica

distancias = dados_pro %>%
  select(-instituicao) %>%
  dist(method = "maximum")

clust_hier <- distancias %>%
  hclust(method = "ward.D")

ggdendrogram(clust_hier, rotate = TRUE)

plot(silhouette(cutree(clust_hier, k = 4), distancias))

atribuicoes <- cbind(dados_pro, grupo = cutree(clust_hier, k = 4))

atribuicoes %>%
  select(-instituicao) %>%
  ggparcoord(columns = c(1:8), groupColumn="grupo", scale = "globalminmax") +
  facet_grid(paste("Grupo ", grupo) ~ .) +
  theme(legend.position = "none") +
  scale_y_continuous(breaks=c(0, 2, 4, 6))

2.2 K-Means

set.seed(1234)
explorando_k <- tibble(k = 2:12) %>%
  group_by(k) %>%
  do(
    kmeans(select(dados_pro, -instituicao), centers = .$k, nstart = 20) %>% glance()
  )

explorando_k %>%
  ggplot(aes(x = k, y = tot.withinss)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks=c(2:12))

explorando_k %>%
  ggplot(aes(x = k, y = betweenss/totss)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = c(2:12))

km <- dados_pro %>%
  select(-instituicao) %>%
  kmeans(centers = 4, nstart = 20)

km %>%
  augment(dados_pro) %>%
  select(-instituicao) %>%
  ggparcoord(columns = c(1:8), groupColumn = ".cluster", scale = "globalminmax") +
  facet_grid(paste("Grupo ", .cluster) ~ .) +
  ylab("Z-score") +
  theme(legend.position = "none")

3. Redução da Dimensionalidade

Principal Component Analysis (PCA)

dados_pca <- dados_pro %>%
  select(-instituicao) %>%
  prcomp(scale = FALSE)

as.data.frame(dados_pca$rotation)
##                            PC1         PC2         PC3        PC4
## nivel               -0.3987424 -0.39555358  0.52035701 -0.3810568
## colaboradores       -0.1695414  0.87508615  0.01662147 -0.2867285
## permanentes         -0.3771071  0.01899928 -0.13278423  0.3423898
## artigos_conf        -0.3700856 -0.05045480 -0.18916490  0.5057392
## dissertacoes        -0.3444813  0.23179410  0.49771651  0.4396016
## teses               -0.3724407  0.02779968  0.13314825 -0.3641500
## periodicos_restrito -0.3847241 -0.13351003 -0.26950427 -0.1122760
## periodicos_qualis   -0.3573444 -0.05028613 -0.58090840 -0.2472224
##                             PC5          PC6         PC7         PC8
## nivel                0.45139603 -0.061567265  0.14935877 -0.19674669
## colaboradores        0.34877604  0.006328333 -0.01758259 -0.03156735
## permanentes          0.05036907  0.752704036  0.37063880 -0.12685934
## artigos_conf         0.32198135 -0.224705020 -0.58701560 -0.26492224
## dissertacoes        -0.37559807 -0.375097007  0.27893822  0.16448305
## teses               -0.59598147  0.281005984 -0.51732230 -0.09165590
## periodicos_restrito  0.14347490 -0.026733780 -0.05119914  0.85147105
## periodicos_qualis   -0.22701321 -0.398417983  0.38389078 -0.33698477
tidy(dados_pca, "pcs") %>%
  ggplot(aes(x = PC, y = cumulative, label = cumulative)) +
  geom_line() +
  geom_point() +
  geom_text(vjust = 1, hjust = -.1)

dados_pro_aug <- km %>% augment(dados)

dados_pca %>%
  augment(dados_pro_aug) %>%
  ggplot(aes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) +
  geom_point(alpha = 0.8) +
  theme(legend.position = "none")

p = dados_pca %>%
  augment(dados_pro_aug) %>%
  hchart("scatter", hcaes(x = .fittedPC1, y = .fittedPC2, color = .cluster)) %>%
  hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
                     Nível: {point.nivel}<br>
             Colaboradores: {point.colaboradores}<br>
               Permanentes: {point.permanentes}<br>
             Artigos Conf.: {point.artigos_conf}<br>
              Dissertações: {point.dissertacoes}<br>
                     Teses: {point.teses}<br>
                Per. A1-B1: {point.periodicos_restrito}<br>
                Per. B2-B5: {point.periodicos_qualis}")
p
autoplot(dados_pca, label = F, label.size = 3, shape = T, colour = km$cluster, loadings = TRUE, loadings.color = 'red', loadings.label = TRUE, loadings.label.size = 3, loadings.label.hjust=1.1)
## Warning in if (value %in% columns) {: a condição tem comprimento > 1 e
## somente o primeiro elemento será usado

t-SNE

set.seed(1234)
tsne.out = dados_pro %>%
  select(-instituicao) %>%
  Rtsne(perplexity = 20)

df <- as.data.frame(tsne.out$Y)
dados_tsne <- cbind(dados_pro_aug, df)

dados_tsne %>%
  ggplot(aes(x = V1, y = V2, color = .cluster)) +
  geom_point(alpha = 0.8) +
  theme(legend.position = "none")

p <- dados_tsne %>%
  hchart("scatter", hcaes(x = V1, y = V2, color = .cluster)) %>%
  hc_tooltip(pointFormat = "<b>{point.instituicao}</b><br>
                     Nível: {point.nivel}<br>
             Colaboradores: {point.colaboradores}<br>
               Permanentes: {point.permanentes}<br>
             Artigos Conf.: {point.artigos_conf}<br>
              Dissertações: {point.dissertacoes}<br>
                     Teses: {point.teses}<br>
                Per. A1-B1: {point.periodicos_restrito}<br>
                Per. B2-B5: {point.periodicos_qualis}")

p